home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b4.d64 / example12.4 < prev    next >
Text File  |  2007-02-28  |  998b  |  31 lines
  1. 0010 DIM KEY'(100), RECNO(100)
  2. 0020 OPEN FILE 2,"INFILE",RANDOM 19
  3. 0030 FOR R:=1 TO 99 DO
  4. 0040 READ FILE 2,R,1: KEY'(R)
  5. 0050 RECNO(R):=R
  6. 0060 ENDFOR R
  7. 0070 CLOSE
  8. 0080 QUICKSORT(1,99)
  9. 0090 OPEN FILE 2,"KEYFILE",RANDOM 10
  10. 0100 FOR R:=1 TO 99 DO WRITE FILE 2,R,1: KEY'(R),RECNO(R)
  11. 0110 FOR R:=1 TO 99 DO READ FILE 2,R,1: KEY'(R),RECNO(R)
  12. 0120 CLOSE
  13. 0130 FOR R:=1 TO 99 DO PRINT KEY'(R);RECNO(R)
  14. 4040 PROC QUICKSORT(LEND,REND) 
  15. 4050 LEFT':=LEND; RIGHT':=REND
  16. 4060 COMP:=KEY'((LEFT'+RIGHT') DIV 2)
  17. 4070 REPEAT 
  18. 4080 WHILE KEY'(LEFT')<COMP DO LEFT':=LEFT'+1
  19. 4090 WHILE KEY'(RIGHT')>COMP DO RIGHT':=RIGHT'-1
  20. 4100 IF LEFT'<=RIGHT' THEN SWAP
  21. 4110 UNTIL LEFT'>RIGHT'
  22. 4120 IF LEND<RIGHT' THEN QUICKSORT(LEND,RIGHT')
  23. 4130 IF LEFT'<REND THEN QUICKSORT(LEFT',REND)
  24. 4140 ENDPROC QUICKSORT
  25. 4150 PROC SWAP 
  26. 4160 TEMP1:=KEY'(LEFT'); TEMP2:=RECNO(LEFT')
  27. 4170 KEY'(LEFT'):=KEY'(RIGHT'); RECNO(LEFT'):=RECNO(RIGHT')
  28. 4180 KEY'(RIGHT'):=TEMP1; RECNO(RIGHT'):=TEMP2
  29. 4190 LEFT':=LEFT'+1; RIGHT':=RIGHT'-1
  30. 4200 ENDPROC SWAP
  31.